fMRI task analyses
Dani Cosme
2023-07-18
This code reproduces the fMRI analyses reported in the following manuscript:
load packages
library(pacman)
pacman::p_load(tidyverse, brms, ggeffects, tidybayes, ROCR, caret, interactions, install = TRUE)
devtools::install_github("hadley/emo")define aesthetics
palette = c("#e64626", "#1985a1", "#4c5c68", "#FAC748")
palette_group = c(palette[2], palette[4])
plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 16),
text = element_text(size = 18, family = "Futura Medium"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())define functions
make_table = function(data) {
data %>%
broom.mixed::tidy(conf.int = TRUE) %>%
filter(effect == "fixed") %>%
mutate(term = gsub("\\(Intercept\\)", "intercept", term),
term = gsub("trial_condregulation", "task condition (mindful attention)", term),
term = gsub("trial_cond_recode", "task condition (mindful attention)", term),
term = gsub("trial_condmindfulattention", "task condition (mindful attention)", term),
term = gsub("dot_between_std_noc", "signature expression (between)", term),
term = gsub("dot_within_std", "signature expression (within)", term),
term = gsub("dot_sd", "signature expression variability", term),
term = gsub("regulation_expression", "signature expression", term),
term = gsub("confidence_rating", "confidence rating", term),
term = gsub(":", " x ", term),
`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, conf.low, conf.high),) %>%
select(term, `b [95% CI]`) %>%
knitr::kable(digits = 2)
}load data
classifier_data = read.csv("../data/classifier_data.csv", stringsAsFactors = FALSE) %>%
mutate(predicted_factor = as.factor(predicted_factor),
actual_factor = as.factor(actual_factor))
ratings = read.csv("../data/ratings.csv", stringsAsFactors = FALSE)
merged = read.csv("../data/task_neuro_data.csv", stringsAsFactors = FALSE)
disaggregated = read.csv("../data/disaggregated_data.csv", stringsAsFactors = FALSE)
disaggregated_mindful = disaggregated %>%
filter(condition == "mindful attention")mindful attention signature development analyses
Here is the weight map from the MVPA analyses:
cross-validation accuracy
✅ We expect that we will be able to train a classifier at the run level to distinguish mindful attention from uninstructed reactivity to alcohol cues with greater than chance accuracy decoding.
caret::confusionMatrix(classifier_data$predicted_factor, classifier_data$actual_factor)## Confusion Matrix and Statistics
##
## Reference
## Prediction react regulate
## react 59 45
## regulate 52 66
##
## Accuracy : 0.5631
## 95% CI : (0.4951, 0.6293)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : 0.03486
##
## Kappa : 0.1261
##
## Mcnemar's Test P-Value : 0.54239
##
## Sensitivity : 0.5315
## Specificity : 0.5946
## Pos Pred Value : 0.5673
## Neg Pred Value : 0.5593
## Prevalence : 0.5000
## Detection Rate : 0.2658
## Detection Prevalence : 0.4685
## Balanced Accuracy : 0.5631
##
## 'Positive' Class : react
## trial-level accuracy
✅ Given that the classifier is developed at the run level, we will also confirm that the expression of the mindful attention signature is evident at the trial-level. That is, we expect the signature expression to be higher during mindful attention trials compared to reactivity trials.
means
plot
data_means = merged %>%
filter(condition == "mindful attention") %>%
mutate(trial_cond = gsub("regulation", "mindful attention", trial_cond),
trial_cond = factor(trial_cond, levels = c("reactivity", "mindful attention")))
data_means %>%
ggplot(aes(trial_cond, dot, color = trial_cond, fill = trial_cond)) +
stat_summary(fun.data = "mean_cl_boot", geom = "bar") +
stat_summary(fun.data = "mean_cl_boot", geom = "errorbar", width = 0, color = "black") +
scale_color_manual(name = "", values = palette) +
scale_fill_manual(name = "", values = palette) +
labs(x = "\ntrial type", y = "signature expression\n") +
plot_aes +
theme(legend.position = "none")
run model
table
make_table(mod_means)| term | b [95% CI] |
|---|---|
| intercept | -7.13 [-7.99, -6.27] |
| task condition (mindful attention) | 13.28 [12.14, 14.44] |
summary
summary(mod_means)## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: dot ~ trial_cond + (1 + trial_cond | pID)
## Data: data_means (Number of observations: 2245)
## Draws: 4 chains, each with iter = 1000; warmup = 500; thin = 1;
## total post-warmup draws = 2000
##
## Group-Level Effects:
## ~pID (Number of levels: 37)
## Estimate Est.Error l-95% CI u-95% CI
## sd(Intercept) 0.49 0.37 0.03 1.38
## sd(trial_condmindfulattention) 0.59 0.47 0.02 1.80
## cor(Intercept,trial_condmindfulattention) -0.21 0.56 -0.97 0.91
## Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 1.00 908 1226
## sd(trial_condmindfulattention) 1.00 1148 1049
## cor(Intercept,trial_condmindfulattention) 1.00 1701 1421
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept -7.13 0.44 -7.99 -6.27 1.00 2840
## trial_condmindfulattention 13.28 0.60 12.14 14.44 1.00 2764
## Tail_ESS
## Intercept 1287
## trial_condmindfulattention 1200
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 14.13 0.21 13.73 14.54 1.00 3704 1445
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).ROC plot
acc_line1 = data.frame(x = c(0, 1), y = c(1, 1))
acc_line2 = data.frame(y = c(0, 1), x = c(0, 0))
merged %>%
filter(condition %in% c("mindful attention")) %>%
filter(!is.na(dot)) %>%
mutate(actual = ifelse(trial_cond == "regulation", 1, 0)) %>%
group_by(condition) %>%
do({
condition = .$condition
pred = prediction(.$dot, .$actual)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut = perf@alpha.values[[1]],fpr = perf@x.values[[1]],tpr = perf@y.values[[1]])
}) %>%
ggplot(aes(fpr, tpr)) +
geom_line(aes(color = condition), size = 1) +
geom_abline(intercept = 0, slope = 1) +
geom_line(data = acc_line1, aes(x, y)) +
geom_line(data = acc_line2, aes(x, y)) +
scale_color_manual(values = palette_group) +
scale_x_continuous(breaks = seq(0, 1, .2)) +
scale_y_continuous(breaks = seq(0, 1, .2)) +
labs(x = "\nfalse positive rate (1 - specificity)", y = "true positive rate (sensitivity)\n") +
plot_aes +
theme(legend.position = "none",
legend.spacing.y = unit(-.1, "cm"))
confusion matrix
conf_data = merged %>%
filter(condition == "mindful attention") %>%
filter(!is.na(dot)) %>%
mutate(predicted = ifelse(dot > 0, "regulation",
ifelse(dot < 0, "reactivity", NA)),
predicted = as.factor(predicted),
trial_cond = as.factor(as.character(trial_cond)))
caret::confusionMatrix(conf_data$predicted, conf_data$trial_cond)## Confusion Matrix and Statistics
##
## Reference
## Prediction reactivity regulation
## reactivity 827 333
## regulation 346 739
##
## Accuracy : 0.6976
## 95% CI : (0.6781, 0.7165)
## No Information Rate : 0.5225
## P-Value [Acc > NIR] : <0.0000000000000002
##
## Kappa : 0.3942
##
## Mcnemar's Test P-Value : 0.6451
##
## Sensitivity : 0.7050
## Specificity : 0.6894
## Pos Pred Value : 0.7129
## Neg Pred Value : 0.6811
## Prevalence : 0.5225
## Detection Rate : 0.3684
## Detection Prevalence : 0.5167
## Balanced Accuracy : 0.6972
##
## 'Positive' Class : reactivity
## efficacy: trial-level craving analyses
H1
✅ Compared to reactivity trials, mindful attention trials will be associated with decreased craving
run model
plot
mod_behavior %>%
spread_draws(b_Intercept, b_trial_condregulation) %>%
mutate(reactivity = b_Intercept,
mindfulness = b_Intercept + b_trial_condregulation) %>%
gather(`trial type`, value, reactivity, mindfulness) %>%
ggplot(aes(y = "", x = value, fill = `trial type`)) +
stat_halfeye(alpha = .5) +
scale_fill_manual(values = c(palette[2], palette[1])) +
scale_y_discrete(expand = c(.1, .1)) +
coord_cartesian(xlim = c(1.5, 2.5)) +
labs(x = "\npredicted craving rating\n", y = "") +
plot_aes
table
make_table(mod_behavior)| term | b [95% CI] |
|---|---|
| intercept | 2.00 [1.76, 2.23] |
| task condition (mindful attention) | -0.12 [-0.23, -0.01] |
summary
summary(mod_behavior)## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: resp ~ 1 + trial_cond + (1 + trial_cond | pID) + (1 | stimulus)
## Data: disaggregated_mindful (Number of observations: 2214)
## Draws: 4 chains, each with iter = 1000; warmup = 500; thin = 1;
## total post-warmup draws = 2000
##
## Group-Level Effects:
## ~pID (Number of levels: 37)
## Estimate Est.Error l-95% CI u-95% CI Rhat
## sd(Intercept) 0.60 0.08 0.47 0.77 1.00
## sd(trial_condregulation) 0.21 0.07 0.06 0.34 1.00
## cor(Intercept,trial_condregulation) -0.09 0.27 -0.53 0.53 1.00
## Bulk_ESS Tail_ESS
## sd(Intercept) 457 713
## sd(trial_condregulation) 385 225
## cor(Intercept,trial_condregulation) 1407 521
##
## ~stimulus (Number of levels: 72)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.39 0.04 0.32 0.47 1.01 631 1005
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept 2.00 0.12 1.76 2.23 1.01 289
## trial_condregulation -0.12 0.05 -0.23 -0.01 1.00 1953
## Tail_ESS
## Intercept 641
## trial_condregulation 1717
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.85 0.01 0.82 0.87 1.00 3292 1564
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).H2
✅ A: We expect that people who have greater expression of the mindful attention signature on average (i.e., L2, between-person expression) will also have lower craving ratings on a trial-by-trial basis.
❌ B: We expect that trials with greater expression of the mindful attention signature compared to one’s average (i.e., L1, within-person expression) will be associated with lower craving ratings on a trial-by-trial basis.
run model
plots
between-person
points_between = disaggregated_mindful %>%
select(pID, resp, trial_cond, dot_between_std_noc) %>%
group_by(pID, trial_cond, dot_between_std_noc) %>%
summarize(resp = mean(resp, na.rm = TRUE)) %>%
mutate(group = ifelse(trial_cond == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")),
type = "between-person") %>%
rename("x" = dot_between_std_noc,
"predicted" = resp)
vals = seq(-2,2,.2)
predicted = ggeffects::ggpredict(mod_h2_int, c("dot_between_std_noc [vals]", "trial_cond"), type = "fe") %>%
data.frame() %>%
mutate(type = "between-person") %>%
mutate(group = ifelse(group == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")))
predicted %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_point(data = points_between, alpha = .4, size = 2) +
geom_line(data = points_between, aes(group = pID), alpha = .4, size = 2, color = "grey") +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
scale_fill_manual(name = "trial type", values = palette) +
scale_color_manual(name = "trial type", values = palette) +
labs(x = expression("\nreactivity " * symbol('\254') * " signature expression " * symbol('\256') * " mindful attention"),
y = "craving rating\n") +
plot_aes +
theme(legend.position = "top")
within-person
points_within = disaggregated_mindful %>%
select(pID, resp, trial_cond, dot_within_std) %>%
mutate(group = ifelse(trial_cond == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")),
type = "within-person") %>%
rename("x" = dot_within_std,
"predicted" = resp)
vals = seq(-4,4,.2)
predicted = ggeffects::ggpredict(mod_h2_int, c("dot_within_std [vals]", "trial_cond"), type = "fe") %>%
data.frame() %>%
mutate(group = ifelse(group == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")))
predicted %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
stat_smooth(data = points_within, aes(group = interaction(pID, group)), geom = "line", method = "lm", alpha = 0.4, se = FALSE, size = 1) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
scale_fill_manual(name = "trial type", values = palette) +
scale_color_manual(name = "trial type", values = palette) +
labs(x = "within-person signature expression (SD)",
y = "craving rating\n") +
plot_aes +
theme(legend.position = "top")
table
make_table(mod_h2_int)| term | b [95% CI] |
|---|---|
| intercept | 2.29 [1.92, 2.67] |
| task condition (mindful attention) | -0.21 [-0.69, 0.24] |
| signature expression (between) | 0.28 [-0.00, 0.56] |
| signature expression (within) | -0.02 [-0.07, 0.04] |
| task condition (mindful attention) x signature expression (between) | -0.49 [-0.97, -0.04] |
| task condition (mindful attention) x signature expression (within) | -0.01 [-0.10, 0.08] |
simple slopes
emmeans::emtrends(mod_h2_int, ~ trial_cond, var="dot_between_std_noc") %>%
data.frame() %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", dot_between_std_noc.trend, lower.HPD, upper.HPD),
trial_cond = recode(trial_cond, "regulation" = "mindful attention")) %>%
select(trial_cond, `b [95% CI]`) %>%
knitr::kable()| trial_cond | b [95% CI] |
|---|---|
| reactivity | 0.28 [-0.00, 0.56] |
| mindful attention | -0.21 [-0.55, 0.18] |
emmeans::emtrends(mod_h2_int, ~ trial_cond, var="dot_within_std") %>%
data.frame() %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", dot_within_std.trend, lower.HPD, upper.HPD),
trial_cond = recode(trial_cond, "regulation" = "mindful attention")) %>%
select(trial_cond, `b [95% CI]`) %>%
knitr::kable()| trial_cond | b [95% CI] |
|---|---|
| reactivity | -0.02 [-0.07, 0.04] |
| mindful attention | -0.03 [-0.09, 0.04] |
summary
summary(mod_h2_int)## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: resp ~ 1 + trial_cond * dot_between_std_noc + trial_cond * dot_within_std + (1 + trial_cond * dot_within_std | pID) + (1 | stimulus)
## Data: disaggregated_mindful (Number of observations: 2193)
## Draws: 4 chains, each with iter = 1000; warmup = 500; thin = 1;
## total post-warmup draws = 2000
##
## Group-Level Effects:
## ~pID (Number of levels: 37)
## Estimate
## sd(Intercept) 0.60
## sd(trial_condregulation) 0.18
## sd(dot_within_std) 0.04
## sd(trial_condregulation:dot_within_std) 0.10
## cor(Intercept,trial_condregulation) -0.01
## cor(Intercept,dot_within_std) 0.21
## cor(trial_condregulation,dot_within_std) 0.04
## cor(Intercept,trial_condregulation:dot_within_std) -0.37
## cor(trial_condregulation,trial_condregulation:dot_within_std) 0.20
## cor(dot_within_std,trial_condregulation:dot_within_std) -0.17
## Est.Error
## sd(Intercept) 0.08
## sd(trial_condregulation) 0.07
## sd(dot_within_std) 0.03
## sd(trial_condregulation:dot_within_std) 0.05
## cor(Intercept,trial_condregulation) 0.28
## cor(Intercept,dot_within_std) 0.41
## cor(trial_condregulation,dot_within_std) 0.43
## cor(Intercept,trial_condregulation:dot_within_std) 0.30
## cor(trial_condregulation,trial_condregulation:dot_within_std) 0.37
## cor(dot_within_std,trial_condregulation:dot_within_std) 0.43
## l-95% CI u-95% CI
## sd(Intercept) 0.46 0.78
## sd(trial_condregulation) 0.03 0.32
## sd(dot_within_std) 0.00 0.11
## sd(trial_condregulation:dot_within_std) 0.01 0.20
## cor(Intercept,trial_condregulation) -0.53 0.55
## cor(Intercept,dot_within_std) -0.72 0.86
## cor(trial_condregulation,dot_within_std) -0.75 0.82
## cor(Intercept,trial_condregulation:dot_within_std) -0.85 0.31
## cor(trial_condregulation,trial_condregulation:dot_within_std) -0.58 0.83
## cor(dot_within_std,trial_condregulation:dot_within_std) -0.87 0.70
## Rhat Bulk_ESS
## sd(Intercept) 1.01 531
## sd(trial_condregulation) 1.00 511
## sd(dot_within_std) 1.00 1010
## sd(trial_condregulation:dot_within_std) 1.00 802
## cor(Intercept,trial_condregulation) 1.01 1802
## cor(Intercept,dot_within_std) 1.00 2602
## cor(trial_condregulation,dot_within_std) 1.00 1979
## cor(Intercept,trial_condregulation:dot_within_std) 1.00 2057
## cor(trial_condregulation,trial_condregulation:dot_within_std) 1.00 1325
## cor(dot_within_std,trial_condregulation:dot_within_std) 1.00 1203
## Tail_ESS
## sd(Intercept) 845
## sd(trial_condregulation) 483
## sd(dot_within_std) 1267
## sd(trial_condregulation:dot_within_std) 863
## cor(Intercept,trial_condregulation) 1100
## cor(Intercept,dot_within_std) 1275
## cor(trial_condregulation,dot_within_std) 1712
## cor(Intercept,trial_condregulation:dot_within_std) 1407
## cor(trial_condregulation,trial_condregulation:dot_within_std) 1508
## cor(dot_within_std,trial_condregulation:dot_within_std) 1443
##
## ~stimulus (Number of levels: 72)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.39 0.04 0.32 0.48 1.01 674 1006
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI
## Intercept 2.29 0.19 1.92 2.67
## trial_condregulation -0.21 0.24 -0.69 0.24
## dot_between_std_noc 0.28 0.14 -0.00 0.56
## dot_within_std -0.02 0.03 -0.07 0.04
## trial_condregulation:dot_between_std_noc -0.49 0.23 -0.97 -0.04
## trial_condregulation:dot_within_std -0.01 0.04 -0.10 0.08
## Rhat Bulk_ESS Tail_ESS
## Intercept 1.01 506 951
## trial_condregulation 1.00 1474 1290
## dot_between_std_noc 1.00 1170 1393
## dot_within_std 1.00 2929 1496
## trial_condregulation:dot_between_std_noc 1.00 1503 1579
## trial_condregulation:dot_within_std 1.00 2527 1464
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.85 0.01 0.82 0.87 1.00 3939 1653
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).sensitivity analyses
mindful signature attention: discriminant validity
To examine discriminant validity, we will apply the mindful attention signature to data from a separate group of participants who were instructed to use a different form of cognitive regulation (i.e., not mindful attention) that is not expected to rely on the same brain regions. We expect lower than chance accuracy decoding alcohol regulation versus reactivity trials.
ROC plot
acc_line1 = data.frame(x = c(0, 1), y = c(1, 1))
acc_line2 = data.frame(y = c(0, 1), x = c(0, 0))
merged %>%
filter(condition %in% c("perspective-taking", "mindful attention")) %>%
filter(!is.na(dot)) %>%
mutate(actual = ifelse(trial_cond == "regulation", 1, 0)) %>%
group_by(condition) %>%
do({
condition = .$condition
pred = prediction(.$dot, .$actual)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut = perf@alpha.values[[1]],fpr = perf@x.values[[1]],tpr = perf@y.values[[1]])
}) %>%
ggplot(aes(fpr, tpr)) +
geom_line(aes(color = condition), size = 1) +
geom_abline(intercept = 0, slope = 1) +
geom_line(data = acc_line1, aes(x, y)) +
geom_line(data = acc_line2, aes(x, y)) +
scale_x_continuous(breaks = seq(0, 1, .2)) +
scale_y_continuous(breaks = seq(0, 1, .2)) +
scale_color_manual(name = "", values = palette_group) +
labs(x = "\nfalse positive rate (1 - specificity)", y = "true positive rate (sensitivity)\n") +
plot_aes +
theme(legend.position = c(.75, .15),
legend.spacing.y = unit(-.1, "cm"))
confusion matrix
conf_data = merged %>%
filter(condition == "perspective-taking") %>%
filter(!is.na(dot)) %>%
mutate(predicted = ifelse(dot > 0, "regulation",
ifelse(dot < 0, "reactivity", NA)),
predicted = as.factor(predicted),
trial_cond = as.factor(as.character(trial_cond)))
caret::confusionMatrix(conf_data$predicted, conf_data$trial_cond)## Confusion Matrix and Statistics
##
## Reference
## Prediction reactivity regulation
## reactivity 469 419
## regulation 341 391
##
## Accuracy : 0.5309
## 95% CI : (0.5062, 0.5554)
## No Information Rate : 0.5
## P-Value [Acc > NIR] : 0.006941
##
## Kappa : 0.0617
##
## Mcnemar's Test P-Value : 0.005221
##
## Sensitivity : 0.5790
## Specificity : 0.4827
## Pos Pred Value : 0.5282
## Neg Pred Value : 0.5342
## Prevalence : 0.5000
## Detection Rate : 0.2895
## Detection Prevalence : 0.5481
## Balanced Accuracy : 0.5309
##
## 'Positive' Class : reactivity
## confidence rating analyses
merged_ratings = disaggregated_mindful %>%
left_join(., ratings)signature expression ~ confidence ratings
We examined the degree to which confidence ratings were associated with neural signature expression
run model
plot
ggeffects::ggpredict(mod_ph_expression, terms = c("confidence_rating", "trial_cond")) %>%
data.frame() %>%
mutate(group = ifelse(group == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention"))) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
scale_fill_manual(name = "trial type", values = palette) +
scale_color_manual(name = "trial type", values = palette) +
labs(x = "instruction confidence rating (SD)",
y = "signature expression\n") +
plot_aes +
theme(legend.position = "top")
table
make_table(mod_ph_expression)| term | b [95% CI] |
|---|---|
| intercept | -7.26 [-8.11, -6.39] |
| confidence rating | 0.04 [-0.81, 0.93] |
| task condition (mindful attention) | 13.42 [12.17, 14.62] |
| confidence rating x task condition (mindful attention) | 0.02 [-1.27, 1.30] |
simple slopes
emmeans::emtrends(mod_ph_expression, ~ trial_cond, var="confidence_rating") %>%
data.frame() %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", confidence_rating.trend, lower.HPD, upper.HPD),
trial_cond = recode(trial_cond, "regulation" = "mindful attention")) %>%
select(trial_cond, `b [95% CI]`) %>%
knitr::kable()| trial_cond | b [95% CI] |
|---|---|
| reactivity | 0.04 [-0.81, 0.93] |
| mindful attention | 0.05 [-0.87, 1.01] |
summary
summary(mod_ph_expression)## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: dot ~ confidence_rating * trial_cond + (1 + trial_cond | pID)
## Data: merged_ratings (Number of observations: 2086)
## Draws: 4 chains, each with iter = 1000; warmup = 500; thin = 1;
## total post-warmup draws = 2000
##
## Group-Level Effects:
## ~pID (Number of levels: 33)
## Estimate Est.Error l-95% CI u-95% CI Rhat
## sd(Intercept) 0.58 0.42 0.02 1.53 1.00
## sd(trial_condregulation) 0.64 0.50 0.02 1.88 1.01
## cor(Intercept,trial_condregulation) -0.21 0.58 -0.99 0.93 1.00
## Bulk_ESS Tail_ESS
## sd(Intercept) 927 923
## sd(trial_condregulation) 1134 975
## cor(Intercept,trial_condregulation) 1036 601
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI
## Intercept -7.26 0.45 -8.11 -6.39
## confidence_rating 0.04 0.45 -0.81 0.93
## trial_condregulation 13.42 0.64 12.17 14.62
## confidence_rating:trial_condregulation 0.02 0.64 -1.27 1.30
## Rhat Bulk_ESS Tail_ESS
## Intercept 1.00 2568 1634
## confidence_rating 1.00 1319 1389
## trial_condregulation 1.00 2384 1537
## confidence_rating:trial_condregulation 1.00 1267 1215
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 14.26 0.22 13.83 14.69 1.00 3127 1591
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).H2 controlling for confidence ratings
We examined the degree to which controlling for confidence ratings affected the results for H2
run model
plots
between-person
points_between = disaggregated_mindful %>%
select(pID, resp, trial_cond, dot_between_std_noc) %>%
group_by(pID, trial_cond, dot_between_std_noc) %>%
summarize(resp = mean(resp, na.rm = TRUE)) %>%
mutate(group = ifelse(trial_cond == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")),
type = "between-person") %>%
rename("x" = dot_between_std_noc,
"predicted" = resp)
vals = seq(-2,2,.2)
predicted = ggeffects::ggpredict(mod_ph_h2, c("dot_between_std_noc [vals]", "trial_cond"), type = "fe") %>%
data.frame() %>%
mutate(type = "between-person") %>%
mutate(group = ifelse(group == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")))
predicted %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_point(data = points_between, alpha = .4, size = 2) +
geom_line(data = points_between, aes(group = pID), alpha = .4, size = 2, color = "grey") +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
scale_fill_manual(name = "trial type", values = palette) +
scale_color_manual(name = "trial type", values = palette) +
labs(x = expression("\nreactivity " * symbol('\254') * " signature expression " * symbol('\256') * " mindful attention"),
y = "craving rating\n") +
plot_aes +
theme(legend.position = "top")
within-person only
points_within = disaggregated_mindful %>%
select(pID, resp, trial_cond, dot_within_std) %>%
mutate(group = ifelse(trial_cond == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")),
type = "within-person") %>%
rename("x" = dot_within_std,
"predicted" = resp)
vals = seq(-4,4,.2)
predicted = ggeffects::ggpredict(mod_ph_h2, c("dot_within_std [vals]", "trial_cond"), type = "fe") %>%
data.frame() %>%
mutate(group = ifelse(group == "regulation", "mindful attention", "reactivity"),
group = factor(group, levels = c("reactivity", "mindful attention")))
predicted %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
stat_smooth(data = points_within, aes(group = interaction(pID, group)), geom = "line", method = "lm", alpha = 0.4, se = FALSE, size = 1) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
geom_line(size = 2) +
scale_fill_manual(name = "trial type", values = palette) +
scale_color_manual(name = "trial type", values = palette) +
labs(x = "within-person signature expression (SD)",
y = "craving rating\n") +
plot_aes +
theme(legend.position = "top")
table
make_table(mod_ph_h2)| term | b [95% CI] |
|---|---|
| intercept | 2.32 [1.93, 2.73] |
| task condition (mindful attention) | -0.20 [-0.71, 0.30] |
| signature expression (between) | 0.27 [-0.02, 0.56] |
| signature expression (within) | -0.01 [-0.07, 0.05] |
| confidence rating | -0.07 [-0.30, 0.15] |
| task condition (mindful attention) x signature expression (between) | -0.48 [-0.94, -0.01] |
| task condition (mindful attention) x signature expression (within) | -0.02 [-0.12, 0.07] |
simple slopes
emmeans::emtrends(mod_ph_h2, ~ trial_cond, var="dot_between_std_noc") %>%
data.frame() %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", dot_between_std_noc.trend, lower.HPD, upper.HPD),
trial_cond = recode(trial_cond, "regulation" = "mindful attention")) %>%
select(trial_cond, `b [95% CI]`) %>%
knitr::kable()| trial_cond | b [95% CI] |
|---|---|
| reactivity | 0.27 [-0.02, 0.55] |
| mindful attention | -0.21 [-0.62, 0.21] |
emmeans::emtrends(mod_ph_h2, ~ trial_cond, var="dot_within_std") %>%
data.frame() %>%
mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", dot_within_std.trend, lower.HPD, upper.HPD),
trial_cond = recode(trial_cond, "regulation" = "mindful attention")) %>%
select(trial_cond, `b [95% CI]`) %>%
knitr::kable()| trial_cond | b [95% CI] |
|---|---|
| reactivity | -0.01 [-0.07, 0.05] |
| mindful attention | -0.03 [-0.11, 0.04] |
summary
summary(mod_ph_h2)## Family: gaussian
## Links: mu = identity; sigma = identity
## Formula: resp ~ 1 + trial_cond * dot_between_std_noc + trial_cond * dot_within_std + confidence_rating + (1 + trial_cond * dot_within_std | pID) + (1 | stimulus)
## Data: merged_ratings (Number of observations: 2034)
## Draws: 4 chains, each with iter = 1000; warmup = 500; thin = 1;
## total post-warmup draws = 2000
##
## Group-Level Effects:
## ~pID (Number of levels: 33)
## Estimate
## sd(Intercept) 0.63
## sd(trial_condregulation) 0.18
## sd(dot_within_std) 0.05
## sd(trial_condregulation:dot_within_std) 0.11
## cor(Intercept,trial_condregulation) -0.11
## cor(Intercept,dot_within_std) 0.19
## cor(trial_condregulation,dot_within_std) 0.02
## cor(Intercept,trial_condregulation:dot_within_std) -0.35
## cor(trial_condregulation,trial_condregulation:dot_within_std) 0.23
## cor(dot_within_std,trial_condregulation:dot_within_std) -0.15
## Est.Error
## sd(Intercept) 0.09
## sd(trial_condregulation) 0.07
## sd(dot_within_std) 0.03
## sd(trial_condregulation:dot_within_std) 0.05
## cor(Intercept,trial_condregulation) 0.28
## cor(Intercept,dot_within_std) 0.40
## cor(trial_condregulation,dot_within_std) 0.42
## cor(Intercept,trial_condregulation:dot_within_std) 0.30
## cor(trial_condregulation,trial_condregulation:dot_within_std) 0.38
## cor(dot_within_std,trial_condregulation:dot_within_std) 0.43
## l-95% CI u-95% CI
## sd(Intercept) 0.49 0.85
## sd(trial_condregulation) 0.04 0.32
## sd(dot_within_std) 0.00 0.12
## sd(trial_condregulation:dot_within_std) 0.02 0.21
## cor(Intercept,trial_condregulation) -0.62 0.47
## cor(Intercept,dot_within_std) -0.68 0.85
## cor(trial_condregulation,dot_within_std) -0.78 0.78
## cor(Intercept,trial_condregulation:dot_within_std) -0.84 0.26
## cor(trial_condregulation,trial_condregulation:dot_within_std) -0.60 0.86
## cor(dot_within_std,trial_condregulation:dot_within_std) -0.85 0.74
## Rhat Bulk_ESS
## sd(Intercept) 1.00 608
## sd(trial_condregulation) 1.01 612
## sd(dot_within_std) 1.00 907
## sd(trial_condregulation:dot_within_std) 1.01 718
## cor(Intercept,trial_condregulation) 1.00 1400
## cor(Intercept,dot_within_std) 1.00 2266
## cor(trial_condregulation,dot_within_std) 1.00 2083
## cor(Intercept,trial_condregulation:dot_within_std) 1.00 2368
## cor(trial_condregulation,trial_condregulation:dot_within_std) 1.00 1507
## cor(dot_within_std,trial_condregulation:dot_within_std) 1.00 1182
## Tail_ESS
## sd(Intercept) 1114
## sd(trial_condregulation) 568
## sd(dot_within_std) 1040
## sd(trial_condregulation:dot_within_std) 772
## cor(Intercept,trial_condregulation) 1261
## cor(Intercept,dot_within_std) 1555
## cor(trial_condregulation,dot_within_std) 1603
## cor(Intercept,trial_condregulation:dot_within_std) 1598
## cor(trial_condregulation,trial_condregulation:dot_within_std) 1157
## cor(dot_within_std,trial_condregulation:dot_within_std) 1327
##
## ~stimulus (Number of levels: 72)
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept) 0.40 0.04 0.33 0.49 1.01 734 1259
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI
## Intercept 2.32 0.20 1.93 2.73
## trial_condregulation -0.20 0.26 -0.71 0.30
## dot_between_std_noc 0.27 0.15 -0.02 0.56
## dot_within_std -0.01 0.03 -0.07 0.05
## confidence_rating -0.07 0.11 -0.30 0.15
## trial_condregulation:dot_between_std_noc -0.48 0.24 -0.94 -0.01
## trial_condregulation:dot_within_std -0.02 0.05 -0.12 0.07
## Rhat Bulk_ESS Tail_ESS
## Intercept 1.00 926 1162
## trial_condregulation 1.00 1965 1521
## dot_between_std_noc 1.00 1540 1472
## dot_within_std 1.00 2679 1468
## confidence_rating 1.01 440 816
## trial_condregulation:dot_between_std_noc 1.00 1946 1536
## trial_condregulation:dot_within_std 1.00 2123 1482
##
## Family Specific Parameters:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma 0.85 0.01 0.82 0.88 1.00 3520 1713
##
## Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).compare posterior distributions
Compare preregistered model with the modeling controlling for confidence ratings
posterior = posterior_samples(mod_h2_int) %>%
transmute(`mindful attention`= b_dot_between_std_noc + `b_trial_condregulation:dot_between_std_noc`,
reactivity = b_dot_between_std_noc) %>%
gather(`trial type`, value) %>%
mutate(model = "original model") %>%
bind_rows(posterior_samples(mod_ph_h2) %>%
transmute(`mindful attention`= b_dot_between_std_noc + `b_trial_condregulation:dot_between_std_noc`,
reactivity = b_dot_between_std_noc) %>%
gather(`trial type`, value) %>%
mutate(model = "controlling for confidence")) %>%
mutate(model = factor(model, levels = c("original model", "controlling for confidence")))
posterior %>%
ggplot(aes(y = "", x = value, fill = model)) +
stat_halfeye(alpha = .5) +
scale_fill_manual(values = palette_group) +
facet_grid(~`trial type`) +
scale_y_discrete(expand = c(.1, .1)) +
labs(x = "\nregression coefficient\n", y = "") +
plot_aes